perm filename SPICT.SAI[SYS,HE]3 blob sn#107053 filedate 1974-06-14 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00015 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	BEGIN "PICTUR" COMMENT PICTUR PROGRAM MODIFIED FOR RAM FORMAT STERO
C00006 00003	α	variables and misc. procedures
C00013 00004	α	BEGINNING OF TVSIX PACKAGE
C00016 00005	α Super fast averager.  SUMS and CLPINC determine the number of 
C00019 00006	α Compute the transformation matrices for the camera model
C00030 00007	⊃	UPDATE THE TRANSFORM FOR SELECTED CAMERA
C00033 00008	⊃	UPDATE CONTINUES
C00035 00009	⊃	STILL MORE UPDATING
C00037 00010	⊃	Now to update the global model
C00042 00011	α	initialize the camera transform routines
C00044 00012	α	first we initialize the world
C00046 00013	α	Quam sixbit or regular TV input
C00048 00014	α	open output file and take picture
C00051 00015	α	add a transform
C00078 ENDMK
C⊗;
BEGIN "PICTUR" COMMENT PICTUR PROGRAM MODIFIED FOR RAM FORMAT STERO
	PICTURES - KKP  11/20/73;

REQUIRE "HELIB[1,3]" LIBRARY;
REQUIRE "DPYSUB.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "VIDSUB[1,PDQ]" LOAD_MODULE;
REQUIRE "SOBMAT[SYS,HE]" LOAD_MODULE;
REQUIRE "PROLOG.HDR[1,PDQ]" SOURCE_FILE;
REQUIRE "TABLE[LIB,HE]" LOAD_MODULE;
REQUIRE 2000 STRING_SPACE;
REQUIRE "⊂⊃||" DELIMITERS;

DEFINE α=⊂COMMENT⊃, EXT=⊂EXTERNAL⊃, INT=⊂INTEGER⊃, PRO=⊂PROCEDURE⊃,
	CRLF=⊂'15&'12⊃, BHEAD(BUF)=⊂((BUF+1) LAND '777777)⊃, REFF=⊂REFERENCE⊃,
	QUEST(QUESTION,TEST)=⊂DO OUTSTR("QUESTION"&CRLF) UNTIL TEST⊃,
	RAD=⊂.0174533⊃,Q=⊂'10000⊃;

EXT PRO PICWR(INT CHAN, FILE, EXTEN, PPN; REFF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO RELCOR(INT IOWD);
EXT INT PRO GETCOR(INT SIZE);
EXT PRO INP;
EXT INT PRO GIOWD(REAL ARRAY BUF);
EXT PRO EYECAL(INT SIZE, FRAM, FLAG; INT ARRAY BUF);
EXT PRO ADJUST;
EXT PRO CWHEEL(INT CODE);
EXT PRO TVIN;
EXTERNAL PROCEDURE SPWON(INTEGER TIC;REFERENCE INTEGER ADDR);
EXTERNAL PROCEDURE SPWOFF;
EXT PRO SUMSUB(REAL ARRAY TV;INT OPTR1,OPTR2,OPTR3);
EXT PROCEDURE INVRT(REAL ARRAY A,AI);
EXT PRO PICWI(INT CH, FL, EXTR,PPN; REFF BOOLEAN FAIL);
EXT PRO PICOUT(REFF BOOLEAN FAIL; INT ARRAY STOR);
EXT PRO PICCLS;
EXT INTEGER PRO TTREAD;
EXT INTEGER PRO TTDELT(REAL R);
α	variables and misc. procedures;

EXT INT TVWORD,FLINE,LLINE,RSIDE,LSIDE,TCLIP,BCLIP,IWID,STATUS,TSERVO,
	LENS, BITS, LINLEN, LINES, TVCAM, STATE, POT, SSERVO;
EXT REAL P1, P2, P3, P4, P5, P6, P7, P8, TTRAD;
SAFE INT ARRAY PNTRS[1:25], PIC[0:9], DPYBUF[1:600];
SAFE REAL ARRAY CAMERA_MODEL[1:10,1:3],PPOT0,PPOTD,TPOT0,TPOTD,FPOT0,FPOTD,
	MART,SWING,FOC,FOCLEN0,GROREF,FOCLENG[1:5],DP,P0[1:5,1:3],
	PP[1:5,1:2],RADIANS[1:10];
INT I,ANS,FSAV,LLSAV,RSAV,LSAV,TVLENG,CAMERR,CLPINC,MINX,MAX,
	SUMPT1,SUMPT2,SUMPT3,TVSIZE,PICSIZE,J,NUMFILE,FILE,PPN,EXTEN,FAIL;
REAL PANPOT, FOCPOT, TILPOT, ZPOTD, ZPOT0, REF, SAVPOS, INCREM;
LABEL LOOP, SKIP, SKIP1,REREAD,L;
BOOLEAN SENSSET, TVREAD, SIXBIT;
STRING STR, TITLE, DESCRIPT, FILENAM;

SIMPLE REAL PROCEDURE LNS(REAL X; INTEGER RLENS);
	RETURN(X*FOC[RLENS]/(X-FOC[RLENS]));

SIMPLE PROCEDURE ARRTO(INTEGER TOO; REFERENCE INTEGER FROM; INTEGER LENG);
	START_CODE JRST ARRBLT; END;

SIMPLE PROCEDURE ARRFROM(REFERENCE INTEGER TOO; INTEGER FROM, LENG);
	START_CODE JRST ARRBLT; END;

α  Conversion  from  Quam  format to hand-eye library style parameters;

SIMPLE PROCEDURE Q2HE(SAFE INTEGER ARRAY PIC);
	BEGIN
	IWID←PIC[SIZEX];
	FLINE←PIC[POSY];
	LSIDE←PIC[POSX];
	RSIDE←LSIDE+IWID-1;
	LLINE←FLINE+PIC[SIZEY]-1;
	LINLEN←PIC[SIZEL];
	BITS←PIC[BIT];
	END "Q2HE";

α  Conversion from hand-eye library parameters to Quam format picture
	header array;

SIMPLE PROCEDURE HE2Q(SAFE INTEGER ARRAY PIC);
	BEGIN
	PIC[SCALEX]←PIC[SCALEY]←1;
	PIC[POSX]←LSIDE;
	PIC[POSY]←FLINE;
	PIC[SIZEX]←RSIDE-LSIDE+1;
	PIC[SIZEY]←LLINE-FLINE+1;
	PIC[SIZEL]←HAT(PIC[SIZEX],36 DIV BITS);
	PIC[BIT]←BITS;
END "HE2Q";
α	BEGINNING OF TVSIX PACKAGE;

SIMPLE PROCEDURE MINMAX(SAFE INTEGER ARRAY PARS);
	BEGIN INTEGER NI,NJ;
	NI←LINLEN*3;
	NJ←PARS[SIZEY];

	START_CODE LABEL LI,LJ;
	DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃,
	    FOO(X)=⊂ILDB A,X;CAMGE A,MINX;MOVEM A,MINX;CAMLE A,MAX;
		MOVEM A,MAX;⊃;
	MOVE P1,SUMPT1;	MOVE P2,SUMPT2;	MOVE P3,SUMPT3;
	MOVE J,NJ;
LJ:	MOVE I,NI;
LI:	FOO(P1)
	FOO(P2)
	FOO(P3)
	SOJG I,LI;
	SOJG J,LJ;
	END;

	END "MINMAX";

α	TVSIX REDUCTION ROUTINE;

SIMPLE PROCEDURE REDUCER(SAFE INTEGER ARRAY PARS);
	BEGIN INTEGER NI,NJ,RPT,LL,SCALE;
	SCALE←(64*Q-1)%(MAX-MINX);
	NI←3*LINLEN;
	NJ←PARS[SIZEY];
	RPT←PARS[PTR];
	LL←PARS[SIZEL];

	START_CODE LABEL L,LI;
	DEFINE A=⊂1⊃,I=⊂2⊃,J=⊂3⊃,P1=⊂4⊃,P2=⊂5⊃,P3=⊂6⊃,R=⊂7⊃,
	    FOO(X)=⊂ILDB A,X;SUB A,MINX;IMUL A,SCALE;ASH A,'777764;
		IDPB A,R;⊃;
	MOVE P1,SUMPT1;	MOVE P2,SUMPT2;	MOVE P3,SUMPT3;
	MOVE R,RPT;
	MOVE J,NJ;
LI:	MOVE I,NI;
L:	FOO(P1)
	FOO(P2)
	FOO(P3)
	SOJG I,L;
	MOVE R,LL;
	ADDB R,RPT;
	SOJG J,LI;
	END;

	END "REDUCER";
α Super fast averager.  SUMS and CLPINC determine the number of 
	averages and clip level ranges;

PROCEDURE SUMMER(INTEGER ARRAY PARS,SUM;INTEGER SUMS,CLPINC);
	BEGIN
	LINLEN←(PARS[SIZEX]-1)%9+1;
	TVSIZE←LINLEN*LINES;
		BEGIN "SUMA"
		REAL ARRAY TVBUF[1:TVSIZE];
		INTEGER SUMCNT;
		SUMPT1←POINT(12,SUM[1,1,1],-1);
		SUMPT2←SUMPT1+TVSIZE;
		SUMPT3←SUMPT2+TVSIZE;
		MINX←1 LSH 34;
		MAX←0;
		TVWORD←GIOWD(TVBUF);
		FOR SUMCNT←1 STEP 1 UNTIL SUMS DO
			BEGIN "SUMB";
			TCLIP←0;
			BCLIP←CLPINC-1;
			WHILE BCLIP ≤ 7 DO
				BEGIN "SUMC"
				TVIN;
				SUMSUB(TVBUF,SUMPT1,SUMPT2,SUMPT3);
				TCLIP←TCLIP+CLPINC;
				BCLIP←BCLIP+CLPINC;
				END "SUMC";
			END "SUMB";
		END "SUMA";
	END "SUMMER";

PROCEDURE TVSIX(SAFE INTEGER ARRAY PARS;INTEGER SUMS,CLPINC);
	BEGIN INTEGER ADR, TVSAV;
	PARS[SIZEL]←(PARS[SIZEX]-1)%6+1;
	TVSAV ← TVWORD;
	ADR←(TVWORD+1) LAND '777777;
	PARS[PTR]←XPOINT(6,ADR,-1);
	PARS[BIT]←6;
	Q2HE(PARS);
	LINLEN←(PARS[SIZEX]-1)%9+1;
	LINES←LLINE-FLINE+1;
		BEGIN "TVA"
		INTEGER ARRAY SUM[1:3,1:LINES,1:LINLEN];
		SUMMER(PARS,SUM,SUMS,CLPINC);
		MINMAX(PARS);
		REDUCER(PARS);
		END "TVA";
	TVWORD ← TVSAV;
	END "TVSIX";
α Compute the transformation matrices for the camera model;

PROCEDURE PANTIL_CAM(INTEGER C;REAL PPOT,TPOT,FPOT,ZPOT;REAL ARRAY COL,ICOL,CENTER);
	BEGIN INTEGER I,J;   
	REAL   ACC,FMX,FMY,PAN,TILT;
        REAL ARRAY RP,RT,RPT,RS,R[1:3,1:3],CC[1:3];
	PAN ← PPOTD[C]*PPOT+PPOT0[C];
        TILT ← TPOTD[C]*TPOT+TPOT0[C];
	FMY ← FPOTD[C]*FPOT+FPOT0[C];
	IF TVCAM=2 THEN FMY ← FMY+ZPOTD/(ZPOT-ZPOT0);
	FMX ← FMY*MART[C];
	RP[2,3]←-1;
	RPT[1,1]←RP[1,1]←RP[3,2]←-SIN(PAN);
        RP[3,1]←-(RPT[1,2]←RP[1,2]←COS(PAN));
	RT[1,1]←1;
	RPT[2,3]←-(RT[2,2]←RT[3,3]←COS(TILT));
        R[3,3]←RPT[3,3]←RT[2,3]←-(RT[3,2]←SIN(TILT));
	RPT[2,1]←RT[2,3]*RP[3,1];
	RPT[2,2]←RT[2,3]*RP[3,2]; 
	R[3,1]←RPT[3,1]←RT[3,3]*RP[3,1];
	R[3,2]←RPT[3,2]←RT[3,3]*RP[3,2];
	RS[3,3]←1;
	RS[1,1]←RS[2,2]←COS(SWING[C]);
	RS[2,1]←-(RS[1,2]←SIN(SWING[C]));
	R[1,1]←RS[1,1]*RPT[1,1]+RS[1,2]*RPT[2,1];
	R[1,2]←RS[1,1]*RPT[1,2]+RS[1,2]*RPT[2,2];
	R[1,3]←RS[1,2]*RPT[2,3];
	R[2,1]←RS[2,1]*RPT[1,1]+RS[2,2]*RPT[2,1];
	R[2,2]←RS[2,1]*RPT[1,2]+RS[2,2]*RPT[2,2];
	R[2,3]←RS[2,2]*RPT[2,3];
	CC[1]←P0[C,1]+R[1,1]*DP[C,1]+R[2,1]*DP[C,2]+R[3,1]*DP[C,3];
	CC[2]←P0[C,2]+R[1,2]*DP[C,1]+R[2,2]*DP[C,2]+R[3,2]*DP[C,3];
	CC[3]←P0[C,3]+R[1,3]*DP[C,1]+R[2,3]*DP[C,2]+R[3,3]*DP[C,3];

	FOR I←1 STEP 1 UNTIL 3 DO
		BEGIN 
		COL[I,1]←R[I,1];
		COL[I,2]←R[I,2];
		ACC←0;
		FOR J←1 STEP 1 UNTIL 3 DO ACC←ACC-R[I,J]*CC[J];
		COL[I,3]←ACC;
		END;
	FOR J←1 STEP 1 UNTIL 3 DO
		BEGIN 
		COL[2,J]←-FMX/333*COL[1,J]+FMY*COL[2,J]
		     +(PP[C,2]-PP[C,1]/333)*COL[3,J];
		COL[1,J]←FMX*COL[1,J]+PP[C,1]*COL[3,J];
		END;
	INVRT(COL,ICOL);
	ARRTRAN(CENTER,CC);
	END "PANTIL";
⊃	UPDATE THE TRANSFORM FOR SELECTED CAMERA;

INTEGER PROCEDURE CAM_UPDATE;
	BEGIN LABEL ETA;
	DEFINE C1="2.1429", C2="-.0006", DEG="57.29578", KY="684.5";
	REAL SFOC,STIL,SPAN,FMAX,FMIN,TMAX,TMIN,PMAX,PMIN,SZOM,ZMAX,IPOT,ZOOPOT,
	   ZMIN,DIFFOC,DIFTIL,DIFPAN,DIFZOM,SIND,IMAX,IMIN,DIFIRIS,SIRIS;
 	SAFE REAL ARRAY MCOL, MICOL[1:3,1:3], LCEN[1:3];
	INTEGER I, IND, UPDFLG;
ETA:	UPDFLG ← SFOC←SPAN←STIL←SZOM←SIRIS←0;
	FMAX←TMAX←PMAX←ZMAX←IMAX←-10000;
	FMIN←TMIN←PMIN←ZMIN←IMIN←10000;
	IF TVCAM=1 THEN
		BEGIN "CM1UPD"
		IMAX ← IMIN ← 0;
		STATUS←1;
		SPWON(1,TSERVO);
		I ← '44;
		FOR IND←0 STEP 1 UNTIL 39 DO
			BEGIN "CM1LOP"
			STATUS←I;
			I ← 4;
			WHILE ¬(STATUS LAND 1) DO;
			IF '100≤STATUS<'100000 THEN DONE;
			SFOC←SFOC+P1;
			STIL←STIL+P2;
			SPAN←SPAN+P3;
			IF P1>FMAX THEN FMAX←P1;
			IF P1<FMIN THEN FMIN←P1;
			IF P2>TMAX THEN TMAX←P2;
			IF P2<TMIN THEN TMIN←P2;
			IF P3>PMAX THEN PMAX←P3;
			IF P3<PMIN THEN PMIN←P3;
			END "CM1LOP";
		SPWOFF;
		END "CM1UPD";
	IF TVCAM=2 THEN
		BEGIN "CM2UPD"
		FOR IND←0 STEP 1 UNTIL 39 DO
			BEGIN "CM2LOP"
			STATE ← 0;
			POT ← 1;
			SPWON(0,SSERVO);
			WHILE ¬STATE DO;
			SPWOFF;
			IF ¬(STATE=1) THEN DONE;
			SPAN←SPAN+P4;
			SFOC←SFOC+P6;
			STIL←STIL+P5;
			SZOM←SZOM+P7;
			SIRIS←SIRIS+P8;
⊃	UPDATE CONTINUES;

			IF P4>PMAX THEN PMAX←P4;
			IF P4<PMIN THEN PMIN←P4;
			IF P5>TMAX THEN TMAX←P5;
			IF P5<TMIN THEN TMIN←P5;
			IF P6>FMAX THEN FMAX←P6;
			IF P6<FMIN THEN FMIN←P6;
			IF P7>ZMAX THEN ZMAX←P7;
			IF P7<ZMIN THEN ZMIN←P7;
			IF P8>IMAX THEN IMAX←P8;
			IF P8<IMIN THEN IMIN←P8;
			END "CM2LOP";
		END "CM2UPD";
	LENS ← IF TVCAM=2 THEN 5 ELSE LENS+1;
	IF IND>0 THEN
		BEGIN "READOK"
		REF← GROREF[LENS];
		FOCPOT←SFOC*REF/IND;
		TILPOT←STIL*REF/IND;
		PANPOT←SPAN*REF/IND;
		IPOT ← SIRIS*REF/IND;
		IF TVCAM=2 THEN ZOOPOT←SZOM*REF/IND;
		IF IND<30 THEN
 			BEGIN "RDLOW"
			OUTSTR("NOT ENOUGH UPDATE READINGS  "&
				CVS(IND)&" "&CRLF);
			UPDFLG ← 8;
			END "RDLOW" ELSE BEGIN "RDHIGH"
			REAL DP, DT, DF, DZ, DI;
	                DIFFOC←(FMAX-FMIN)*REF;
			DIFTIL←(TMAX-TMIN)*REF;
			DIFPAN←(PMAX-PMIN)*REF;
			DIFIRIS←(IMAX-IMIN)*REF;
			IF TVCAM=2 THEN DIFZOM←(ZMAX-ZMIN)*REF;
	                SIND←4*SQRT(IND);
			DZ ← IF TVCAM=2 THEN DIFZOM/SIND ELSE 0;
			DF←DIFFOC/SIND;
			DT←DIFTIL/SIND;
			DP←DIFPAN/SIND;
			DI←DIFIRIS/SIND;
⊃	STILL MORE UPDATING;

	                IF DI>.75∨DP>.75∨DT>.75∨DF>1∨(TVCAM=2∧DZ>1) THEN
				BEGIN "DIFBAD"
	      			OUTSTR("UPDATE POTS TOO NOISY ");
				IF DF>1.0 THEN OUTSTR("     DIFFOC="&
					CVF(DIFFOC));
				IF DT>.75 THEN OUTSTR("     DIFTIL="&
					CVF(DIFTIL));
				IF DP>.75 THEN OUTSTR("     DIFPAN="&
					CVF(DIFPAN));        
				IF DI>.75 THEN OUTSTR("     DIFIRIS="&
					CVF(DIFIRIS));        
				IF DZ>1.0 THEN OUTSTR("     DIFZOM="&
					CVF(DIFZOM));
				OUTSTR(NULL&CRLF);
				UPDFLG ← 9;
				END "DIFBAD";
			END "RDHIGH";
		END "READOK" ELSE BEGIN "READBD"
		OUTSTR("AD NOT AVAILABLE"&CRLF);
		UPDFLG ← 10;
		END "READBD";
	IF UPDFLG THEN
		BEGIN "ERROR"
		OUTSTR("...TYPE Y TO TRY AGAIN:"&CRLF);
		IF INCHWL="Y" THEN GOTO ETA ELSE
		IF UPDFLG=10 THEN
			BEGIN "ADERR"
			OUTSTR("CAM_UPDATE-FAILED"&CRLF);
			RETURN(UPDFLG);
			END "ADERR";
		END "ERROR";

⊃	NOW WE HAVE A GOOD SET OF POT READINGS, UPDATE THE TRANSFORM;

	PANTIL_CAM(LENS,PANPOT,TILPOT,FOCPOT,ZOOPOT,MCOL,MICOL,LCEN);
	IF TVCAM=2 THEN
		BEGIN
		FOC[5] ← C1+ZOOPOT+C2;
		FOCLEN0[5] ← FPOT0[5]+ZPOTD/((ZOOPOT-ZPOT0)*KY);
		FOCLENG[5] ← FPOTD[5]/KY;
		END;
⊃	Now to update the global model;

	ARRBLT (CAMERA_MODEL[1,1],MCOL[1,1],9);
  	ARRBLT (CAMERA_MODEL[6,1],MICOL[1,1],9);
	ARRBLT (CAMERA_MODEL[4,1],LCEN[1],3);
	CAMERA_MODEL[5,1] ← PP[LENS,1];
	CAMERA_MODEL[5,2] ← PP[LENS,2];
	CAMERA_MODEL[5,3] ← 1.0;
	CAMERA_MODEL[9,1] ← (PPOTD[LENS]*PANPOT+PPOT0[LENS])*DEG;
	CAMERA_MODEL[9,2] ← (TPOTD[LENS]*TILPOT+TPOT0[LENS])*DEG;
	CAMERA_MODEL[9,3] ← LNS(FOCLEN0[LENS]+FOCLENG[LENS]*FOCPOT,LENS);
	CAMERA_MODEL[10,3] ← IPOT;
        CAMERA_MODEL[10,2] ← IF TVCAM=1 THEN LENS ELSE FOC[5]*25.4;
	CAMERA_MODEL[10,1]←TVCAM;
	RETURN(UPDFLG);
	END "CAM_UPDATE";

α	convert string to text in array;

INTEGER PROCEDURE ARRYCOM(STRING S);
	BEGIN INTEGER STRT, LENG, BUF;
	LENG ← LENGTH(S);
	LENG ← IF ¬(LENG MOD 5) THEN LENG DIV 5 ELSE (LENG DIV 5)+1;
		BEGIN INTEGER ARRAY X[1:LENG];
		INTEGER I;
		FOR I←1 STEP 1 UNTIL LENG DO
			BEGIN
			X[I] ← CVASC(S[1 FOR 5]);
			S ← S[6 TO ∞];
			END;
		BUF ← GETCOR(LENG);
		STRT ← BHEAD(BUF);
		ARRTO(STRT,X[1],LENG);
		END;
	RETURN(BUF);
	END;
α	initialize the camera transform routines;

DEFINE DATASET=⊂(IF CAMNOM=1 THEN "DATA1[CAL,HE]" ELSE
	"DATA2[CAL,HE]")⊃,
		DATA=⊂3⊃;

PROCEDURE COMIN(INTEGER I);
	BEGIN DEFINE XF(X)="ARRYIN(DATA,X,1)",AF(X,N)="ARRYIN(DATA,X,N)";
	IF I=5 THEN BEGIN XF(ZPOT0);XF(ZPOTD);END;
	XF(PPOT0[I]);
	XF(PPOTD[I]);
	XF(TPOT0[I]);
	XF(TPOTD[I]);
	XF(FPOT0[I]);
	XF(FPOTD[I]);
	XF(MART[I]);
	XF(SWING[I]);
	AF(PP[I,1],2);
	AF(P0[I,1],3);
	AF(DP[I,1],3);
	XF(FOC[I]);
	XF(FOCLEN0[I]);
	XF(FOCLENG[I]);
	XF(GROREF[I]);
	END;

SIMPLE BOOLEAN PROCEDURE CAM_INIT;
	BEGIN INTEGER BRK, EOF, S, CAMNOM;
	OPEN(DATA,"DSK",12,3,0,128,BRK,EOF);
	FOR CAMNOM←1,2 DO
		BEGIN
		I ← IF CAMNOM=1 THEN 4 ELSE 1;
		FOR S ← 1 STEP 1 UNTIL I DO
			BEGIN
			LOOKUP(DATA,DATASET,BRK);
			IF BRK THEN
				BEGIN
				OUTSTR(DATASET&" NOT FOUND"&CRLF);
				RETURN(TRUE);
				END;
			USETI(DATA,1);
			BRK←WORDIN(DATA);
			USETI(DATA,S);
			COMIN(IF CAMNOM=1 THEN S ELSE 5);
			END;
		CLOSE(DATA);
		END;
	RELEASE(DATA);
	RETURN(FALSE);
	END;
α	first we initialize the world;

	SENSSET ← FALSE;
	CAMERR ← CAM_INIT;
LOOP:	PNTRS[1] ← 0;
	ARRBLT(PNTRS[2],PNTRS[1],24);
	QUEST (	|Cohu or Sierra?|,|(ANS←INCHWL)="C" ∨ ANS="S"|);
	TVCAM ← IF ANS="C" THEN 1 ELSE 2;
	CWHEEL(3);
	TCLIP ← 0;
	BCLIP ← 7;

α	adjust size if picture, if desired;

	IF TVREAD THEN
		BEGIN "ADJREC"
		QUEST (|same area as last time? (Yes or No)|,
			|(ANS←INCHWL)="Y"∨ANS="N"|);
		IF ANS="Y" THEN GO TO SKIP;
		END "ADJREC" ELSE TVREAD ← TRUE;
	OUTSTR("Adjust the size of the image."&CRLF&
	    "Type any character when you are done."&CRLF);

		BEGIN "ADJUST"
		REAL ARRAY BUF[1:10000];
		TVWORD ← GIOWD(BUF);
		INP;
		CLRBUF;
		FSAV ← FLINE;
		LLSAV ← LLINE;
		RSAV ← RSIDE;
		LSAV ← LSIDE;
		END "ADJUST";

	DESCRIPT ← TITLE ←NULL;
α	Quam sixbit or regular TV input;

SKIP:	QUEST (	|4 or 6 bit image (4 or 6)?|,|(BITS←CVD(INCHWL))=6∨BITS=4|);
	IF (SIXBIT←BITS=6) THEN
		BEGIN "QUAM"
		REAL ARRAY BUF[1:400];
		TVWORD ← GIOWD(BUF);
		OUTSTR("Adjust target voltage for good image"&crlf&
			"Type Y when finished");
		EYECAL(600,1,FALSE,DPYBUF);
		CLRBUF;
		BITS ← 6;
		FLINE ← FSAV;
		LLINE ← LLSAV;
		RSIDE ← RSAV;
		LSIDE ← LSAV;
		RELPOG(1);
		END "QUAM";
	TVLENG ← ((RSIDE-LSIDE+1)/(36 DIV BITS)+1)*(LLINE-FLINE+1);
	TVWORD ← GETCOR(TVLENG);

α	set sensitivity;

	IF SIXBIT THEN GO TO SKIP1;
	IF SENSSET THEN
		BEGIN "ALLSET"
		QUEST (	|change sensitivity? (No or Yes)|,
			|(ANS←INCHWL)="Y"∨ANS="N"|);
		IF ANS="N" THEN GO TO SKIP1;
		END "ALLSET" ELSE BEGIN "STEST"
		SENSSET ← TRUE;
		QUEST (|set clips? (Yes or No)|,|(ANS←INCHWL)="Y"∨ANS="N"|);
		IF ANS="N" THEN GO TO SKIP1;
		END "STEST";
	OUTSTR("Type Y when satisfied"&crlf);
	EYECAL(600,1,TRUE,DPYBUF);
	CLRBUF;
	RELPOG(1);
	FLINE ← FSAV;
	LLINE ← LLSAV;
	RSIDE ← RSAV;
	LSIDE ← LSAV;
SKIP1:	IWID ← RSIDE-LSIDE+1;
	IF SIXBIT THEN BITS ← 6;
	ADJUST;
α	open output file and take picture;

	OUTSTR(CRLF&"FILE NAME=");
	FILENAM←INCHWL;
	FILE ← CVFIL(FILENAM,EXTEN,PPN);
	PICWI(1,FILE,EXTEN,PPN,FAIL);
	IF FAIL THEN USERERR(0,0,"OPEN FAILED FOR "&FILENAM);
	OUTSTR("NUMBER OF PICTURES=");
	NUMFILE ← 10 MIN CVD(INCHWL);
	OUTSTR("TABLE ROTATION IN DEGREES (MAGNITUDE > 0.25) = ");
	STR ← INCHWL;
	INCREM ← REALSCAN(STR,I);
	IF ABS(INCREM)<.25 THEN INCREM ← IF INCREM THEN .25 ELSE -.25;
	INCREM ← INCREM*RAD;
	IF SIXBIT THEN HE2Q(PIC);
REREAD:	I ← TTREAD;
	IF I<0 THEN
L:		USERERR(0,0,"TURNTABLE COUNT INVALID, YOU LOSE!");
	IF I>0 THEN
		BEGIN
		OUTSTR("TABLE COUNTER MUST BE INITIALIZED"&CRLF);
		IF TTDELT(180)<0 THEN GO TO L;
		OUTSTR("RESET TABLE TO PROPER POSITION AND TYPE CR");
		INCHWL;
	 	GO TO REREAD;
		END;
	SAVPOS ← TTRAD;
	FOR I←1 STEP 1 UNTIL NUMFILE DO 
		BEGIN "TAKE"
		REAL FINAL, INC;
		IF SIXBIT THEN TVSIX(PIC,1,1) ELSE TVIN;
		PNTRS[14+I]←0;
		PNTRS[15+I]←TVWORD+1;
		PICOUT(FAIL,PNTRS);
		IF TTREAD<0 THEN GO TO L;
		RADIANS[I] ← TTRAD/RAD;
		FINAL ← TTRAD+INCREM;
		INC ← INCREM;
		IF I≠NUMFILE THEN DO
		    BEGIN "MOVE"
		    IF TTDELT(INC)<0 THEN GO TO L;
		    INC ← FINAL-TTRAD;
		    END "MOVE" UNTIL ABS(INC/RAD)<.25;
		END "TAKE";
	PNTRS[15+NUMFILE] ← 0;
	WHILE TTDELT(SAVPOS-TTRAD)>0 DO;
	IF SIXBIT THEN Q2HE(PIC);
	RELCOR(TVWORD);
α	add a transform;

	IF ¬CAMERR THEN CAMERR←CAMERR∨(CAM_UPDATE=10);
	IF CAMERR THEN OUTSTR("CAMERA ERROR - NO TRANSFORM"&CRLF) ELSE
		PNTRS[7] ← GIOWD(CAMERA_MODEL)+1;
	PNTRS[15] ← GIOWD(RADIANS)+1;

⊃	AJTHACK for objects above the table surface;
	OUTSTR("Are the objects on the table? ");
	IF INCHWL="N" THEN
		 BEGIN REAL TABLE_DZ;STRING STR;
                 OUTSTR("How high,Oh Lord, how high?");
		   TABLE_DZ←REALSCAN(STR←INCHWL,I);
		   CAMERA_MODEL[4,3]←CAMERA_MODEL[4,3]-TABLE_DZ;
		   END;

α	finish output to disk;

	OUTSTR("Would you like a title (Yes or No)?");
	IF INCHWL="Y" THEN
		BEGIN
		OUTSTR("type title, ending with carriage return"&crlf);
		TITLE ← INCHWL;
		END;
	OUTSTR("would you like to add a description (Yes of No)?");
	IF INCHWL="Y" THEN
		BEGIN
		OUTSTR("type description ending with carraige return "&
			"∀ carriage return");
		WHILE TRUE DO IF LENGTH(STR←INCHWL)∧STR[1 FOR 1]="∀"
			THEN DONE ELSE DESCRIPT ← DESCRIPT&STR&CRLF;
		END;
	PNTRS[5] ← IF LENGTH(TITLE) THEN ARRYCOM(TITLE)+1 ELSE 0;
	PNTRS[6] ← IF LENGTH(DESCRIPT) THEN ARRYCOM(DESCRIPT)+1 ELSE 0;
	PICOUT(FAIL,PNTRS);
	PICCLS;
	RELEASE(1);
	IF PNTRS[5] THEN RELCOR(PNTRS[5]-1);
	IF PNTRS[6] THEN RELCOR(PNTRS[6]-1);
	OUTSTR("FILE "&FILENAM&" WRITTEN OUT"&CRLF);

α	return for next picture;

	OUTSTR("another picture (Yes or No)?");
	IF INCHWL ="Y" THEN GO TO LOOP;
END;